home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 001-025 / disk_013 / mandelbrot / mandelbrot.bas < prev    next >
BASIC Source File  |  1992-05-06  |  19KB  |  445 lines
  1. 1 '
  2. 1 ' Tacky, hacky program to do Mandelbrot pretty color pictures
  3. 1 '
  4. 1 ' Some storage declarations
  5. 1 '   XOrigin        Real part Origin
  6. 1 '   YOrigin        Imaginary part origin
  7. 1 '   Iterations%    Maximum number of iterations for each point
  8. 1 '   DeltaX         Maximum X delta
  9. 1 '   DeltaY         Maximum Y delta
  10. 1 '   X%             Current X coordinate
  11. 1 '   Y%             Current Y coordinate
  12. 1 '   XInc%          X increment
  13. 1 '   YInc%          Y increment
  14. 1 '   ScreenX%       Screen X coordinate
  15. 1 '   ScreenY%       Screen Y coordinate
  16. 1 '   MouseX         Screen X coordinate of mouse origin
  17. 1 '   MouseY         Screen Y coordinate of mouse origin
  18. 1 '   MouseDX        Screen delta X for mouse box
  19. 1 '   Scale%()       Current scaling array
  20. 1 '   Screen%        An array to save the screen into
  21. 1 '   FileName$      The filename to write the screen into
  22. 1 '   Resolution%    Screen resolution (0=320, 1=640)
  23. 1 '   BitPlanes%     Number of bit planes to use
  24. 1 '   Prompt$        Command prompt string
  25. 1 '   Command$       Command string
  26. 1 '   Upper$         String of upper case characters
  27. 1 '   Lower$         String of lower case characters
  28. 1 '   LowerCase%     Non-zero if lower case characters are ok from the command
  29. 1 '   Valid%         Non-zero if the screen data is valid
  30. 1 '   MouseValid%    Non-zero if the mouse data is valid
  31. 1 '   Default        Default numeric argument
  32. 1 '   Result         Numeric argument from keyboard
  33. 1 '   Direction%     Sign of direction for UP/DOWN/LEFT/RIGHT
  34. 1 '   Code%          Array containing iteration loop code
  35. 1 '   Regs%          Array containing registers for LibCall
  36. 1 '   ContourValid%  Non-zero if contouring array has been built
  37. 1 '   Boot%          True if we're bootstrapping
  38. 1 '
  39. 1000 Dim Scale%(2000), Screen%(16010), Code%(150), Regs%(16)
  40. 1010 Upper$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  41. 1020 Lower$ = "abcdefghijklmnopqrstuvwxyz"
  42. 1030 Def FnMax(a%, b%) = a% - (a% < b%) * (b% - a%)
  43. 1035 Boot% = 0                            ' Assume not booting
  44. 1 '
  45. 1 ' Read the initial mandelbrot set:
  46. 1 '
  47. 1040 FileName$ = "MandelSet.640"
  48. 1050 GoSub 13000 : If Success% Then GoTo 1100
  49. 1060 FileName$ = "MandelSet.320"
  50. 1070 GoSub 13000 : If Success% Then GoTo 1100
  51. 1075 XOrigin = -2.0 : YOrigin = -1.125 : DeltaX = 3.99 : DeltaY = DeltaX * 180 / 320
  52. 1076 Iterations% = 250 : Resolution% = 0  ' Default iterations and resolution
  53. 1077 BitPlanes% = 4                       ' Default number of bit planes
  54. 1080 FileName$ = "MandelSet.320"          ' Default bootstrap filename
  55. 1090 Boot% = -1                           ' We're bootstrapping !
  56. 1 '
  57. 1 ' Read the iteration loop from disk:
  58. 1 '
  59. 1100 BLoad "MandelMung", VarPtr(Code%(0))
  60. 1 '
  61. 1 ' Zero all the regs:
  62. 1 '
  63. 1110 For I% = 0 to 15
  64. 1120    Regs%(I%) = 0
  65. 1130 Next I%
  66. 1140 ContourValid% = 0                  ' Contour array isn't valid yet
  67. 1150 MouseValid% = 0                    ' No valid mouse data yet
  68. 1 '
  69. 1 ' Setup the screen
  70. 1 '
  71. 2000 RGB 0, 0, 0, 0                     ' Set color register zero to black
  72. 2010 RGB 1, 6, 9, 15                    ' Set color register 1 to dark blue
  73. 2020 Screen Resolution%, BitPlanes%, 0  ' Setup screen resolution
  74. 2030 ScnClr                             ' Make sure the screen is clear
  75. 2040 If Boot% Then GoTo 6000            ' Compute set if in boot mode
  76. 2050 GShape (0, 0), Screen%()           ' Restore the old screen data
  77. 2060 Valid% = 1                         ' Say our data isn't valid
  78. 1 '
  79. 1 ' Look for some commands:
  80. 1 '
  81. 3000 GoSub 10000                 ' Wait for the user to be ready
  82. 3010 GShape (0, 0), Screen%      ' Restore the screen
  83. 3015 Prompt$ = "Command: "       ' Get the command prompt
  84. 3020 LowerCase% = 0              ' Make sure everything's upper case
  85. 3025 GoSub 14000                 ' Get the command string
  86. 3030 If Command$ = "EXIT"  Then End
  87. 3035 If Command$ = "GO"    Then GoTo 6000
  88. 3040 If Command$ = "SAVE"  Then GoTo 3100
  89. 3045 If Command$ = "RESET" Then GoTo 1010
  90. 3050 If Command$ = "READ"  Then GoTo 3200
  91. 3055 If Command$ = "CLEAR" Then GoTo 3500
  92. 3060 If Command$ = "SET"   Then GoTo 3300
  93. 3065 If Command$ = "SHOW"  Then GoTo 3400
  94. 3070 If Command$ = "UP"    Then GoTo 3600
  95. 3075 If Command$ = "DOWN"  Then GoTo 3610
  96. 3077 If Command$ = "RIGHT" Then GoTo 3700
  97. 3079 If Command$ = "LEFT"  Then GoTo 3710
  98. 3080 If Command$ = "ZOOM"  Then GoTo 3800
  99. 3085 If Command$ = "MOUSE" Then GoTo 4000
  100. 3090 If Command$ = "SYSTEM" Then System
  101. 3097 If Command$ = "HELP"  Then GoTo 3900
  102. 3098 If Command$ = ""      Then GoTo 3000
  103. 3099 Print at (0,0) "? Command error";: GoTo 3000
  104. 1 '
  105. 1 ' He wants to save something, prompt for the filename:
  106. 1 '
  107. 3100 If Valid% Then GoTo 3120    ' Only do this if screen active
  108. 3110 Print at (0,0) "? Data not computed";: GoTo 3000
  109. 3120 Prompt$ = "File name: "     ' Ask him for a filename
  110. 3130 LowerCase% = 1              ' Say lowercase here is ok
  111. 3140 GoSub 14000                 ' Go get the filename
  112. 3150 FileName$ = Command$        ' Copy the filename
  113. 3160 GoSub 12000                 ' Go write the file
  114. 3165 Boot% = 0                   ' We aren't booting anymore I guess
  115. 3170 If Success% Then GoTo 3010  ' Ok, go ask for another command
  116. 3180 Print at (0,0) "? File write error";
  117. 3190 GoTo 3000                   ' Wait for the mouse again
  118. 1 '
  119. 1 ' He wants to read a file.  Prompt for it:
  120. 1 '
  121. 3200 Prompt$ = "File name: "     ' Ask him for a filename
  122. 3210 LowerCase% = 1              ' Say lowercase here is ok
  123. 3220 GoSub 14000                 ' Ask for the filename
  124. 3230 FileName$ = Command$        ' Copy the filename
  125. 3240 GoSub 13000                 ' Go read the file
  126. 3250 If Success% Then GoTo 2000  ' Re-init the screen if happy
  127. 3260 Print at (0,0) "? File read error - Reset";
  128. 3270 GoSub 10000                 ' Wait for a mouse button
  129. 3280 GoTo 1010                   ' And restart
  130. 1 '
  131. 1 ' Prompt the user for the new values:
  132. 1 '
  133. 3300 Prompt$ = "X Origin "   : Default = XOrigin         : GoSub 16000
  134. 3305 XOrigin = Result
  135. 3310 Prompt$ = "Y Origin "   : Default = YOrigin         : GoSub 16000
  136. 3315 YOrigin = Result
  137. 3320 Prompt$ = "Delta X "    : Default = DeltaX          : GoSub 16000
  138. 3325 DeltaX = Result : DeltaY = DeltaX * 180/320
  139. 3330 Prompt$ = "Iterations " : Default = Iterations%     : GoSub 16000
  140. 3335 Iterations% = Result
  141. 3340 Prompt$ = "Resolution " : Default = Resolution%     : GoSub 16000
  142. 3345 Resolution% = Result
  143. 3350 Prompt$ = "Bit Planes " : Default = BitPlanes%      : GoSub 16000
  144. 3355 BitPlanes% = Result
  145. 3360 If ((Resolution% + BitPlanes%) < 6) And (Resolution% > -1) And (Resolution% < 2) And (BitPlanes% > 0) Then 3390
  146. 3370 Print at (0,0) "? Illegal resolution/bitplane values" : GoTo 3000
  147. 3390 GoTo 3880                   ' Say the screen and mouse isn't valid
  148. 1 '
  149. 1 ' Show the current values:
  150. 1 '
  151. 3400 If MouseValid% = 0 Then Print at (0,0) "X Origin = "; XOrigin; " Y Origin = "; YOrigin
  152. 3405 If MouseValid% = 1 Then Print at (0,0) "X Origin = "; MouseX ; " Y Origin = "; MouseY
  153. 3410 If MouseValid% = 0 Then Print "Delta X  = "; DeltaX; " Delta Y  = "; DeltaY
  154. 3415 If MouseValid% = 1 Then Print "Delta X  = "; MouseDX;" Delta Y  = "; MouseDY
  155. 3420 Print "Iterations = "; Iterations%
  156. 3430 Print "Resolution = "; Resolution%
  157. 3450 Print "  Bit Planes = "; BitPlanes%;
  158. 3460 GoTo 3000
  159. 1 '
  160. 1 ' Here if we want to clear the data just set.  About the only thing that
  161. 1 ' can be done is default back to the current screen data
  162. 1 '
  163. 3500 GoSub 13500                             ' Yank the data back from Screen%
  164. 3510 Valid% = 1                              ' Say the screen's valid again
  165. 3520 GoTo 2000                               ' Back to the prompt loop
  166. 1 '
  167. 1 ' Here if we want to increment Y some fraction of the screen:
  168. 1 '
  169. 3600 Direction% = 1 : GoTo 3620              ' Set sign of increment
  170. 1 '
  171. 1 ' Here if we want to decrement Y some fraction of the screen:
  172. 1 '
  173. 3610 Direction% = -1                         ' Set the sign of the increment
  174. 3620 Prompt$ = "Screen fraction "            ' Set the prompt
  175. 3630 Default = .5                            ' Assume half the screen
  176. 3640 GoSub 16000                             ' Read the screen fraction
  177. 3650 YOrigin = YOrigin + (DeltaY * Result * Direction%)
  178. 3660 GoTo 3880                               ' Screen data not valid
  179. 1 '
  180. 1 ' Here if we want to increment X some fraction of the screen:
  181. 1 '
  182. 3700 Direction% = 1 : GoTo 3720              ' Set sign of the increment
  183. 1 '
  184. 1 ' Here if we want to decrement X some fraction of the screen:
  185. 1 '
  186. 3710 Direction% = -1                         ' Set sign of the increment
  187. 3720 Prompt$ = "Screen fraction "            ' Set the prompt
  188. 3730 Default = .5                            ' Assume half the screen
  189. 3740 GoSub 16000                             ' Read the screen fraction
  190. 3750 XOrigin = XOrigin + (DeltaX * Result * Direction%)
  191. 3760 GoTo 3880                               ' Screen is no longer valid
  192. 1 '
  193. 1 ' If here we want to zoom in or out.  > 1 is zoom in, < 1 is zoom out
  194. 1 '
  195. 3800 Prompt$ = "Zoom Factor "                ' Set the prompt
  196. 3810 Default = 2                             ' Assume twice resolution
  197. 3820 GoSub 16000                             ' Get the zoom factor
  198. 3830 If Result > 0 Then GoTo 3860            ' Check range
  199. 3840 Print "? Must be greater than 0"        ' Complain
  200. 3850 GoTo 3000                               ' Let him think about it
  201. 3860 DeltaX = DeltaX / Result                ' Scale the DeltaX
  202. 3870 DeltaY = DeltaY / Result                ' Scale the DeltaY
  203. 3880 Valid% = 0                              ' Screen's no longer valid
  204. 3885 MouseValid% = 0                         ' No more mouse data
  205. 3890 GoTo 3010                               ' Prompt again
  206. 1 '
  207. 1 ' Give some hint as to what we're about:
  208. 1 '
  209. 3900 Print at (0,0) "One of the following commands:"
  210. 3905 Print "Clear  Clear data just set"
  211. 3910 Print "Down   Reset Y origin downwards"
  212. 3915 Print "Exit   Exit Mandelbrot.Bas"
  213. 3920 Print "Go     Compute the new set"
  214. 3925 Print "Help   Show this text"
  215. 3930 Print "Left   Reset X origin left"
  216. 3933 Print "Mouse  Use mouse to set origin"
  217. 3935 Print "Read   Read a saved screen"
  218. 3940 Print "Reset  Reset program"
  219. 3945 Print "Right  Reset X origin right"
  220. 3950 Print "Save   Save the screen"
  221. 3955 Print "Set    Set new data"
  222. 3960 Print "Show   Show current settings"
  223. 3965 Print "System Exit to CLI or workbench"
  224. 3970 Print "Up     Reset Y origin upwards"
  225. 3975 Print "Zoom   Zoom current settings"
  226. 3980 Print "Press left mouse button to continue"
  227. 3999 GoTo 3000
  228. 1 '
  229. 1 ' Here to set the new coordinates using the mouse:
  230. 1 '
  231. 4000 GoSub 20000                 ' Go get the new coordinates
  232. 4010 Print at (0,0) "X = "; MouseX
  233. 4020 Print "Y = "; MouseY
  234. 4030 Print "DeltaX = "; MouseDX
  235. 4040 Print "DeltaY = "; MouseDY
  236. 4050 GoTo 3000
  237. 1 '
  238. 1 ' Main loop here:
  239. 1'
  240. 6000 If ContourValid%= 0 Then GoSub 11000    ' Compute the contour map
  241. 6001 If MouseValid% = 0 Then GoTo 6010       ' Skip this if mouse not valid
  242. 6002 XOrigin = MouseX : YOrigin = MouseY
  243. 6003 DeltaX = MouseDX : DeltaY = MouseDY
  244. 6010 Screen Resolution%, BitPlanes%, 0       ' Setup the screen resolution
  245. 6020 ScnClr                                  ' And start with a clean screen
  246. 6023 XInc% = (2 ^ 30 * DeltaX / 320 / (Resolution% + 1))
  247. 6024 YInc% = (2 ^ 30 * DeltaY / 180)         ' Compute increments
  248. 6030 Y% = YOrigin * (2 ^ 30)                 ' Set initial Y
  249. 6040 For ScreenY% = 179 to 0 Step -1         ' Outside loop is Y%
  250. 6050    X% = XOrigin * (2 ^ 30)              ' Set initial X again
  251. 6060    For ScreenX% = 0 to (320 * (Resolution% + 1) - 1) Step 1
  252. 1 '
  253. 1 ' Initialize a single point's values:
  254. 1 '
  255. 6070       Regs%(0) = X% : Regs%(1) = Y%
  256. 6080       Regs%(2) = Iterations%
  257. 1 '
  258. 1 ' Per point loop:
  259. 1 '
  260. 6100       LibCall VarPtr(Code%(0)), 0, Regs%()
  261. 6110       I% = Peek_W(VarPtr(Regs%(2)) + 2)  ' Get the iteration count
  262. 6120       If I% > (Iterations% - 1) Then GoTo 6300
  263. 1 '
  264. 1 ' Here if we bummed out.  Plot the point
  265. 1 '
  266. 6200       Draw (ScreenX%, ScreenY%), Scale%(I% + 1)
  267. 1 '
  268. 1 ' Bump to the next point
  269. 1'
  270. 6300       X% = X% + XInc%
  271. 6310    Next ScreenX%
  272. 6320    Y% = Y% + YInc%
  273. 6330 Next ScreenY%
  274. 1 '
  275. 1 ' All done!
  276. 1 '
  277. 6340 Valid% = 1                        ' Say we're valid again
  278. 6350 MouseValid% = 0                   ' Mouse data isn't valid
  279. 6360 SShape (0, 0; (320 * (Resolution% + 1)) - 1, 199), Screen%
  280. 6370 If Boot% Then Goto 3160 Else GoTo 3000
  281. 1 '
  282. 1 ' Write the data file out and quit
  283. 1 '
  284. 7000 GoSub 10000                       ' Wait for the mouse button
  285. 7010 GoSub 12000                       ' Write the file out
  286. 7020 End                               ' End of proggie
  287. 1 '
  288. 1 ' Subroutine to wait for the mouse button to be pressed
  289. 1 '
  290. 10000 Ask Mouse X%, Y%, Button%
  291. 10010 If Button% = 0 Then GoTo 10000
  292. 10020 Return
  293. 1 '
  294. 1 ' Subroutine to fill in the scaling array given the number of bit planes
  295. 1 ' desired.
  296. 1 '
  297. 11000 Interval% = 1
  298. 11010 Print at (0,0) "Computing contouring array";
  299. 11020 I% = 1
  300. 11030 Color% = 1
  301. 11040 For J% = 1 to Interval%
  302. 11050    If I% <= 2000 Then Scale%(I%) = Color%
  303. 11060    I% = I% + 1
  304. 11070 Next J%
  305. 11080 If I% > 1000 Then GoTo 11130
  306. 11090 Color% = Color% + 1
  307. 11100 If Color% < (2 ^ BitPlanes%) Then 11040
  308. 11110 Interval% = Interval% + 2
  309. 11120 GoTo 11030
  310. 11130 ContourValid% = 1       ' So we don't have to do this again
  311. 11140 Return
  312. 1 '
  313. 1 '      The disk file is created/read with BSAVE/BLOAD into array Screen%.
  314. 1 ' The first elements of this array are obtained from/fed to SShape/GShape.
  315. 1 ' We load values into this array following the screen data itself.  On
  316. 1 ' write, the location in the array is determined by the resolution we're
  317. 1 ' writing.  When reading the file, the offset can be obtained from the
  318. 1 ' resolution implied by the width paramter in the front of the array.
  319. 1 '
  320. 1 ' The values appended to the screen array are:
  321. 1 '
  322. 1 ' Byte #     Contents
  323. 1 ' ==== =     ========
  324. 1 '    0       File format version number (1)
  325. 1 '    1       Screen resolution mode (0 or 1)
  326. 1 '   2-3      Iteration count
  327. 1 '   4-7      X Origin
  328. 1 '  8-11      Y Origin
  329. 1 ' 12-15      Delta X
  330. 1 ' 16-19      Delta Y
  331. 1 '
  332. 12000 SShape (0, 0; (320 * (Resolution% + 1) - 1), 199), Screen%()
  333. 12010 I% = (2000 * BitPlanes% * (Resolution% + 1)) + 2
  334. 12020 Poke VarPtr(Screen%(I%)), 2
  335. 12030 Poke VarPtr(Screen%(I%))+1, Resolution%
  336. 12040 Poke_W VarPtr(Screen%(I%))+2, Iterations%
  337. 12050 Screen%(I%+1) = Peek_L(VarPtr(XOrigin))
  338. 12060 Screen%(I%+2) = Peek_L(VarPtr(YOrigin))
  339. 12070 Screen%(I%+3) = Peek_L(VarPtr(DeltaX))
  340. 12080 Screen%(I%+4) = Peek_L(VarPtr(DeltaY))
  341. 12090 Success% = 0 : On Error GoTo 12130                 ' In case of errors
  342. 12100 BSave FileName$, Varptr(Screen%(0)), (I% + 5) * 4
  343. 12110 Success% = 1 : On Error GoTo 0
  344. 12120 Return
  345. 12130 Resume 12120
  346. 1 '
  347. 1 ' Converse of the previous routine, this routine restores a screen to
  348. 1 ' memory.  See the previous subroutine for notes on the file format.
  349. 1 '
  350. 13000 Success% = 0 : On Error GoTo 13660   ' In case the file lookup fails
  351. 13010 BLoad FileName$, VarPtr(Screen%(0))
  352. 13020 On Error GoTo 0
  353. 13500 BitPlanes% = Peek_W(VarPtr(Screen%(0)))
  354. 13510 Width% = Peek_W(VarPtr(Screen%(0))+2)
  355. 13520 If Width% < 320 Then Resolution% = 0 Else Resolution% = 1
  356. 13530 I% = (2000 * BitPlanes% * (Resolution% + 1)) + 2
  357. 13540 FileVersion% = Peek(VarPtr(Screen%(I%)))
  358. 13550 If (FileVersion% > 0) And (FileVersion% < 3) Then GoTo 13580
  359. 13560 Print "? File version number error"
  360. 13570 Return
  361. 13580 If FileVersion% < 2 Then Iterations% = Peek(VarPtr(Screen%(I%))+2)
  362. 13590 If FileVersion% >= 2 Then Iterations% = Peek_W(VarPtr(Screen%(I%))+2)
  363. 13600 Poke_L VarPtr(XOrigin), Peek_L(VarPtr(Screen%(I%+1)))
  364. 13610 Poke_L VarPtr(YOrigin), Peek_L(VarPtr(Screen%(I%+2)))
  365. 13620 Poke_L VarPtr(DeltaX), Peek_L(VarPtr(Screen%(I%+3)))
  366. 13630 Poke_L VarPtr(DeltaY), Peek_L(VarPtr(Screen%(I%+4)))
  367. 13640 Success% = 1
  368. 13650 Return
  369. 13660 Resume 13650
  370. 1 '
  371. 1 ' Subroutine to prompt for and read a command.  Called with the command
  372. 1 ' prompt in Prompt$, and returns the command keyword (uppercased) in
  373. 1 ' Command$.  We'll restore the screen after we're done.
  374. 1 '
  375. 14000 Print at (0,0) Prompt$;
  376. 14010 Input "", Command$
  377. 14020 GShape (0, 0), Screen%        ' Restore the screen
  378. 14030 If LowerCase% Then Return     ' Return now if lower case is ok
  379. 1 '
  380. 1 ' Subroutine to uppercase the alpha characters in the command string.
  381. 1 '
  382. 15000 For I% = 1 to Len(Command$)
  383. 15010    J% = InStr(1, Lower$, Mid$(Command$, I%, 1))
  384. 15030    If J% Then Replace$(Command$, I%, 1) = Mid$(Upper$, J%, 1)
  385. 15040 Next I%
  386. 15050 Return
  387. 1 '
  388. 1 ' Prompt for a numeric argument, preserving the old value if appropriate
  389. 1 '
  390. 16000 Prompt$ = Prompt$ + "(" + Str$(Default) + "): "
  391. 16010 GoSub 14000                   ' Go prompt and read the number
  392. 16020 If Command$ = "" Then Result = Default Else Result = Val(Command$)
  393. 16030 Return
  394. 1 '
  395. 1 ' Routine to take new coordinates from mouse input.
  396. 1 ' User positions mouse to lower left corner of intended
  397. 1 ' area to zoom, clicks mouse button once.  Position mouse
  398. 1 ' to upper left corner, click mouse button again.  This
  399. 1 ' goes to great lengths to preserve the proper aspect
  400. 1 ' ratio.
  401. 1 '
  402. 20000 PenA 1                     ' Set the default writing color
  403. 20005 XoverY = 320 * (Resolution% + 1) / 180 : YoverX = 1 / XoverY
  404. 1 '
  405. 1 ' Wait for the button to be pressed while on screen
  406. 1 '
  407. 20010 Ask Mouse X%, Y%, Button%  ' Go read the mouse
  408. 20020 If X% < 0 or Y% < 0 Then GoTo 20010 ' Ignore if not in window
  409. 20030 If X% > ((Resolution% + 1) * 320) - 1 Then GoTo 20010
  410. 20040 If Y% > 179 Then GoTo 20010    ' Ignore if too big also
  411. 20050 If Button% = 0 Then GoTo 20010 ' Wait for mouse buttom
  412. 20060 MouseX% = X% : MouseY% = Y% : NewDX% = 0 : OldDX% = 0
  413. 1 '
  414. 1 ' Wait for the button to be released
  415. 1 '
  416. 20070 While Button% <> 0: Ask Mouse X%, Y%, Button%: Wend
  417. 1 '
  418. 1 ' Loop here waiting for the second pressing of the button
  419. 1 '
  420. 20080 While Button% = 0
  421. 20090    If X% < MouseX% Then GoTo 20210     ' Don't make negative boxes
  422. 20100    If Y% > MouseY% Then GoTo 20210
  423. 20110    If X% > ((Resolution% + 1) * 320) -1 Then GoTo 20210
  424. 20120    If Y% > 179 Then GoTo 20210         ' Don't bother if too big
  425. 20130    OldDX% = NewDX%                     ' Copy the old delta X
  426. 20140    NewDX% = FnMax ((X% - MouseX%), int(XoverY * (MouseY% - Y%)))
  427. 20150    If NewDX% = OldDX% Then GoTo 20210  ' Don't bother if no change
  428. 20160    GShape (0, 0), Screen%              ' Something moved, restore the old screen
  429. 20170    X% = MouseX% + NewDX%               ' Find the corner
  430. 20180    Y% = MouseY% - int(YoverX * NewDX%) '  of the box
  431. 20190    Draw (MouseX%, MouseY% to X%, MouseY% to X%, Y%), 1
  432. 20200    Draw (X%, Y% to MouseX%, Y% to MouseX%, MouseY%), 1
  433. 20210    Ask Mouse X%, Y%, Button%           ' Get the new mouse position
  434. 20220 Wend
  435. 20230 MouseValid% = 1                        ' Say we have valid mouse data
  436. 20240 Gshape (0, 0), Screen%                 ' Restore the screen
  437. 20250 MouseX = XOrigin + DeltaX * MouseX% / (320 * (Resolution% + 1))
  438. 20260 MouseY = YOrigin + (DeltaX * 180 / 320) * (179 - MouseY%) / 180
  439. 20270 MouseDX = DeltaX * NewDX% / (320 * (Resolution% + 1))
  440. 20280 MouseDY = MouseDX * 180 / 320
  441. 20290 Return
  442.  
  443.  
  444.  
  445.